'目的：将文档中所有的数字变成文本
'场景：文档中的章节数字是由多级列表自动生成，
'使用该脚本之后再复制章节名称，将不再有章节层级，且完整保留章节号
Sub number_to_text()
    ActiveDocument.Content.ListFormat.ConvertNumbersToText
End Sub

'目的：将word文档中的图片，全部按照统一的规则调整大小
'场景：将png全部拖到word中，
'即便使用了pngyu，使得所有的图片的PPI全部为300，
'即便是我们精心统一了图片的尺寸，
'将这些图片一个个的调整到合适大小还是一件很费心的工作
'使用这个脚本可以将所有的图片，缩放到我们期望的大小
Sub setpicsize()
    Dim n
    Dim picwidth
    Dim picheight
    On Error Resume Next '忽略错误
    ' 先看看一共有多少个图片
    For n = 1 To ActiveDocument.InlineShapes.Count
        ' step1：还原这些图片的原始大小
        ActiveDocument.InlineShapes(n).ScaleHeight = 100 '将图片的高度，全部还原成100%
        ActiveDocument.InlineShapes(n).ScaleWidth = 100 '将图片的宽度，全部还原成100 % 
        ' step2：将这些图片的原始大小存起来
        picheight = ActiveDocument.InlineShapes(n).Height '新建一个变量，存高度 ，初始值为图片原始高度的100 % 
        picwidth = ActiveDocument.InlineShapes(n).Width '新建一个变量，存宽度，初始值为图片原始宽度的100%
        ' step3：将这些图片缩放到自己期望的比例
        ActiveDocument.InlineShapes(n).Height = picheight * 0.71 '将图片的高度，设定为原始高度的71%
        ActiveDocument.InlineShapes(n).Width = picwidth * 0.71 '将图片的宽度，设定为原始宽度的71 % 
        ' step4：将这些图片设定为左对齐
        ActiveDocument.InlineShapes(n).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft '将图片设定为左对齐
        'ActiveDocument.InlineShapes(n).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter'将图片设定为居中对齐
    Next n
End Sub

'表格调整第1步，按照内容调整
Sub set_table_format_1()
    Set mytabless = ActiveDocument.Tables ' 找到所有的表格
    For x = 1 To mytabless.Count
        mytabless(x).Select '选中这个表格
        Selection.ClearFormatting '清除这个选中区域的样式，也就是这个表格内容样式
        'Selection.Style = "Table Grid"'给表格设定一个样式，实际操作并不是很好用，就注释了
        Selection.Style = ActiveDocument.Styles("SE-TEXT")'将选表格的内容的样式，设定为期望值，这里也是在设定单元格内容横向对齐：居左
        'Selection.Style = ActiveDocument.Styles("正文")'大部分人是没有“SE-TEXT”这个样式的，但是“正文”这个样式，应该是有的
        
        Selection.Font.Size = 8 '将表格的字号设定为8
        Selection.Rows.HeightRule = wdRowHeightAtLeast '单元格的行高规则：wdRowHeightAtLeast
        Selection.Rows.Height = CentimetersToPoints(0) '单元格的行高：可以到0
        
        Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter '单元格内容纵向对齐：居中
        
        Selection.Tables(1).Rows.Alignment = wdAlignRowLeft '表格对齐，整体靠左
        
        Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)'表格自动调整规则：按照内容调整
        
        Selection.Tables(1).Rows.WrapAroundText = False '表格的环绕：否
        
        ' 接下来是给表格画外侧left，top，right，bottom，这4根框线
        With Selection.Borders(wdBorderLeft)
            .LineStyle = Options.DefaultBorderLineStyle
            .LineWidth = Options.DefaultBorderLineWidth
            .Color = Options.DefaultBorderColor
        End With
        With Selection.Borders(wdBorderTop)
            .LineStyle = Options.DefaultBorderLineStyle
            .LineWidth = Options.DefaultBorderLineWidth
            .Color = Options.DefaultBorderColor
        End With
        With Selection.Borders(wdBorderRight)
            .LineStyle = Options.DefaultBorderLineStyle
            .LineWidth = Options.DefaultBorderLineWidth
            .Color = Options.DefaultBorderColor
        End With
        With Selection.Borders(wdBorderBottom)
            .LineStyle = Options.DefaultBorderLineStyle
            .LineWidth = Options.DefaultBorderLineWidth
            .Color = Options.DefaultBorderColor
        End With
        
        ' 接下来是给表格画内侧所有的横向，纵向线
        With Selection.Borders(wdBorderHorizontal)
            .LineStyle = Options.DefaultBorderLineStyle
            .LineWidth = Options.DefaultBorderLineWidth
            .Color = Options.DefaultBorderColor
        End With
        With Selection.Borders(wdBorderVertical)
            .LineStyle = Options.DefaultBorderLineStyle
            .LineWidth = Options.DefaultBorderLineWidth
            .Color = Options.DefaultBorderColor
        End With
    Next x
End Sub

'表格调整第2步，按照窗口调整
Sub set_table_format_2()
    Set mytabless = ActiveDocument.Tables ' 找到所有的表格
    For x = 1 To mytabless.Count
        mytabless(x).Select '选中这个表格
        Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow) '表格自动调整规则：按照窗口调整
    Next x
End Sub


Sub AllInOne()' 将调整表格的第1步，第2步，顺序执行
    Call set_table_format_1
    Call set_table_format_2
End Sub



Sub FormatPics()
    Dim Shap As InlineShape
    For Each Shap In ActiveDocument.InlineShapes
        If Shap.Type = wdInlineShapePicture Then
            Shap.LockAspectRatio = msoFalse '不锁定纵横比
            Shap.Height = CentimetersToPoints(6)'高7CM
            Shap.Width = CentimetersToPoints(4.5) '宽10CM
        End If
    Next
End Sub


Sub set_table_format_0()
    Set mytabless = ActiveDocument.Tables
    For x = 1 To mytabless.Count
        mytabless(x).Select
        'table should not around by text
        Selection.Tables(1).Rows.WrapAroundText = False
    Next x
End Sub



Sub overpicture()
    Dim oShape As Variant, shapeType As WdWrapType
    On Error Resume Next
    If MsgBox("Y将图片由嵌入式转为浮动式,N将图片由浮动式转为嵌入式", 68) = 6 Then
        shapeType = Val(InputBox(Prompt = "请输入图片版式:0=四周型,1=紧密型, " & vbLf & _"3=衬于文字下方,4=浮于文字上方", Default = 0))
        For Each oShape In ActiveDocument.InlineShapes
            oShape.Select
            Set oShape = oShape.ConvertToShape
            With oShape
                Select Case shapeType
                    Case 0, 1
                    .WrapFormat.Type = shapeType
                    Case 3
                    .WrapFormat.Type = 3
                    .ZOrder 5
                    Case 4
                    .WrapFormat.Type = 3
                    .ZOrder 4
                    Case Else
                    Exit Sub
                End Select
                .WrapFormat.AllowOverlap = False    '不允许重叠
            End With
        Next
    Else
        For Each oShape In ActiveDocument.Shapes
            oShape.ConvertToInlineShape
        Next
    End If
End Sub




'UPDATE TABLE step1
'UPDATE TABLE
Sub set_table_format_3()
    Set mytabless = ActiveDocument.Tables
    For x = 1 To mytabless.Count
        mytabless(x).Select
        'Selection.ClearFormatting
        'Selection.Style = ActiveDocument.Styles("SE-TEXT")
        'set font size of table into 9
        'Selection.Font.Size = 9
        
        'Selection.Rows.HeightRule = wdRowHeightAtLeast
        'Selection.Rows.Height = CentimetersToPoints(0)
        'Function-1:set vertical alignment to center
        Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
        
        'Function-1:Distribute Width
        'Selection.Cells.DistributeWidth
        
        'step 2
        'Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
        
        
        'Selection.Tables(1).Rows.Alignment = wdAlignRowLeft
        Selection.Tables(1).Rows.WrapAroundText = False
        
        
    Next x
End Sub


Sub set_table_head()
    Set mytabless = ActiveDocument.Tables
    For x = 1 To mytabless.Count
        mytabless(x).Cell(1, 1).Select
        Selection.SelectRow
        'Selection.Font.AllCaps = True
        Selection.Shading.ForegroundPatternColor = wdColorGray25
        Selection.Shading.BackgroundPatternColor = wdColorGray25
        'Selection.Shading.ForegroundPatternColor = wdColorLightTurquoise
        'Selection.Shading.BackgroundPatternColor = wdColorLightTurquoise
        Selection.Font.Bold = 1
    Next x
End Sub

Sub nolight()
    Selection.WholeStory
    Options.DefaultHighlightColorIndex = wdNoHighlight
    Selection.Range.HighlightColorIndex = wdNoHighlight
End Sub



Sub number_to_text1()
    Dim kgslist As List
    For Each kgslist In ActiveDocument.Lists
        kgslist.ConvertNumbersToText
    Next
End Sub


Sub cleanfomart()
    For i = 1 To ActiveDocument.Paragraphs.Count
        If ActiveDocument.Paragraphs.Item(i).OutlineLevel = wdOutlineLevelBodyText
            Then ActiveDocument.Paragraphs.Item(i).Style = "se-text"
        End If
    Next i
    
    
End Sub

Sub StyleLevel_1Replace()
    Dim search_style As String ' the style which apparently seem out of style
    Dim replace_style As String ' the desired style
    search_style = "SE-1"
    replace_style = "SE-1"
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles(search_style)
        .Replacement.ClearFormatting
        .Replacement.Style = ActiveDocument.Styles(replace_style)
        .Wrap = wdFindContinue
        .Execute Replace = wdReplaceAll
    End With
End Sub
Sub StyleLevel_2Replace()
    Dim search_style As String ' the style which apparently seem out of style
    Dim replace_style As String ' the desired style
    search_style = "SE-2"
    replace_style = "SE-2"
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles(search_style)
        .Replacement.ClearFormatting
        .Replacement.Style = ActiveDocument.Styles(replace_style)
        .Wrap = wdFindContinue
        .Execute Replace = wdReplaceAll
    End With
End Sub
Sub StyleLevel_3Replace()
    Dim search_style As String ' the style which apparently seem out of style
    Dim replace_style As String ' the desired style
    search_style = "SE-3"
    replace_style = "SE-3"
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles(search_style)
        .Replacement.ClearFormatting
        .Replacement.Style = ActiveDocument.Styles(replace_style)
        .Wrap = wdFindContinue
        .Execute Replace = wdReplaceAll
    End With
End Sub
Sub StyleLevel_4Replace()
    Dim search_style As String ' the style which apparently seem out of style
    Dim replace_style As String ' the desired style
    search_style = "SE-4"
    replace_style = "SE-4"
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles(search_style)
        .Replacement.ClearFormatting
        .Replacement.Style = ActiveDocument.Styles(replace_style)
        .Wrap = wdFindContinue
        .Execute Replace = wdReplaceAll
    End With
End Sub
Sub StyleLevel_5Replace()
    Dim search_style As String ' the style which apparently seem out of style
    Dim replace_style As String ' the desired style
    search_style = "SE-5"
    replace_style = "SE-5"
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles(search_style)
        .Replacement.ClearFormatting
        .Replacement.Style = ActiveDocument.Styles(replace_style)
        .Wrap = wdFindContinue
        .Execute Replace = wdReplaceAll
    End With
End Sub
Sub StyleLevel_6Replace()
    Dim search_style As String ' the style which apparently seem out of style
    Dim replace_style As String ' the desired style
    search_style = "SE-6"
    replace_style = "SE-6"
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles(search_style)
        .Replacement.ClearFormatting
        .Replacement.Style = ActiveDocument.Styles(replace_style)
        .Wrap = wdFindContinue
        .Execute Replace = wdReplaceAll
    End With
End Sub
Sub StyleLevel_7Replace()
    Dim search_style As String ' the style which apparently seem out of style
    Dim replace_style As String ' the desired style
    search_style = "SE-7"
    replace_style = "SE-7"
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles(search_style)
        .Replacement.ClearFormatting
        .Replacement.Style = ActiveDocument.Styles(replace_style)
        .Wrap = wdFindContinue
        .Execute Replace = wdReplaceAll
    End With
End Sub
Sub StyleLevel_8Replace()
    Dim search_style As String ' the style which apparently seem out of style
    Dim replace_style As String ' the desired style
    search_style = "SE-8"
    replace_style = "SE-8"
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles(search_style)
        .Replacement.ClearFormatting
        .Replacement.Style = ActiveDocument.Styles(replace_style)
        .Wrap = wdFindContinue
        .Execute Replace = wdReplaceAll
    End With
End Sub
Sub StyleLevel_9Replace()
    Dim search_style As String ' the style which apparently seem out of style
    Dim replace_style As String ' the desired style
    search_style = "SE-9"
    replace_style = "SE-9"
    With Selection.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles(search_style)
        .Replacement.ClearFormatting
        .Replacement.Style = ActiveDocument.Styles(replace_style)
        .Wrap = wdFindContinue
        .Execute Replace = wdReplaceAll
    End With
End Sub




'暂时还没有找到怎么在VS code中美化vba代码的插件
'目前使用的是在线美化工具：http://tools.jb51.net/code/vbscodeformat
